home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / database / postgres / postgre4.z / postgre4 / src / lib / C / lispdep.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-08-27  |  20.3 KB  |  1,084 lines
  1. /*
  2.  * lispdep.c --
  3.  *    LISP-dependent C code.
  4.  *
  5.  *    This is where we really get our hands dirty with LISP guts.
  6.  *
  7.  *    Used in:
  8.  *        parser/*.c
  9.  *        fmgr/{fmgr,ppreserve}.c
  10.  *        util/{plancat,rlockutils,syscache}.c
  11.  */
  12.  
  13. #include <strings.h>
  14. #include <stdio.h>
  15.  
  16. #include "tmp/postgres.h"
  17.  
  18. RcsId("$Header: /private/postgres/src/lib/C/RCS/lispdep.c,v 1.38 1991/11/14 15:03:50 jolly Exp $");
  19.  
  20. #include "nodes/pg_lisp.h"
  21. #include "parser/atoms.h"
  22. #include "utils/palloc.h"
  23. #include "utils/log.h"
  24. #include "tmp/stringinfo.h"
  25.  
  26. #include "lib/equalfuncs.h"
  27.  
  28. /* ----------------
  29.  *    _copy function extern declarations
  30.  * ----------------
  31.  */
  32. #include "lib/copyfuncs.h"
  33.  
  34. /*
  35.  *    Allocation and manipulation routines.
  36.  *
  37.  *    XXX It may be assumed that garbage collection has been turned off
  38.  *        before these routines are called.
  39.  *
  40.  *    lispAtom - new atom with print name set to the argument
  41.  *    lispDottedPair - new uninitialized cons cell
  42.  *    lispFloat - new floating point number (>= 32 bit)
  43.  *    lispInteger - new integer (>= 32-bit)
  44.  *    lispString - new string (null-delimited)
  45.  *    lispVectori - new byte vector (size in bytes >= argument)
  46.  *    evalList - eval the argument
  47.  *    quote - quote the argument symbol (only really necessary for Franz?)
  48.  */
  49.  
  50. /* ===================== PGLISP ==================== */
  51.  
  52.  
  53. char *
  54. CString(lstr)
  55.      LispValue lstr;
  56. {
  57.     if (stringp(lstr))
  58.     return(LISPVALUE_STRING(lstr));
  59.     else {
  60.     elog(WARN,"CString called on non-string\n");
  61.     return(NULL);
  62.     }
  63. }
  64.  
  65. int 
  66. CAtom(lv)
  67.      LispValue lv;
  68. {
  69.     if (atom(lv))
  70.     return ((int)(LISPVALUE_SYMBOL(lv)));
  71.     else {
  72.     elog(WARN,"CAtom called on non-atom\n");
  73.     return (NULL);
  74.     }
  75. }
  76.  
  77. double
  78. CDouble(lval)
  79.      LispValue lval;
  80. {
  81.     if (floatp(lval))
  82.     return(LISPVALUE_DOUBLE(lval));
  83.     
  84.     elog(WARN,"error : bougs float");
  85.     return((double)0);
  86. }
  87. int
  88. CInteger(lval)
  89.      LispValue lval;
  90. {
  91.     if (integerp(lval) || atom(lval))
  92.     return(LISPVALUE_INTEGER(lval));
  93.     
  94.     elog(WARN,"error : bogus integer");
  95.     return(0);
  96. }
  97.  
  98. /* ----------------
  99.  *    lispAtom actually returns a node with type T_LispSymbol
  100.  * ----------------
  101.  */
  102. LispValue
  103. lispAtom(atomName)
  104.     char *atomName; 
  105. {
  106.     LispValue    newobj = lispAlloc();
  107.     int     keyword;
  108.     ScanKeyword    *search_result;    
  109.  
  110.     search_result = ScanKeywordLookup(atomName);
  111.     Assert(search_result);
  112.  
  113.     keyword = search_result->value;
  114.  
  115.     LISP_TYPE(newobj) =         PGLISP_ATOM;
  116.     newobj->equalFunc =     _equalLispValue;
  117.     newobj->outFunc =         _outLispValue;
  118.     newobj->copyFunc =         _copyLispSymbol;
  119.     LISPVALUE_SYMBOL(newobj) =     (char *) keyword;
  120.     CDR(newobj) =         LispNil;
  121.     
  122.     return(newobj);
  123. }
  124.  
  125. /* ----------------
  126.  *    lispDottedPair actually returns a node of type T_LispList
  127.  * ----------------
  128.  */
  129. LispValue
  130. lispDottedPair()
  131. {
  132.     LispValue    newobj = lispAlloc();
  133.     
  134.     LISP_TYPE(newobj) =         PGLISP_DTPR;
  135.     newobj->equalFunc =     _equalLispValue;
  136.     newobj->outFunc =         _outLispValue;
  137.     newobj->copyFunc =         _copyLispList;
  138.     CAR(newobj) =         LispNil;
  139.     CDR(newobj) =         LispNil;
  140.  
  141.     return(newobj);
  142. }
  143.  
  144. /* ----------------
  145.  *    lispFloat returns a node of type T_LispFloat
  146.  * ----------------
  147.  */
  148. LispValue
  149. lispFloat(floatValue)
  150.     double    floatValue;
  151. {
  152.     LispValue    newobj = lispAlloc();
  153.  
  154.     LISP_TYPE(newobj) =         PGLISP_FLOAT;
  155.     newobj->equalFunc =     _equalLispValue;
  156.     newobj->outFunc =         _outLispValue;
  157.     newobj->copyFunc =        _copyLispFloat;
  158.     LISPVALUE_DOUBLE(newobj) =     floatValue;
  159.     CDR(newobj) =         LispNil;
  160.  
  161.     return(newobj);
  162. }
  163.  
  164. /* ----------------
  165.  *    lispInteger returns a node of type T_LispInt
  166.  * ----------------
  167.  */
  168. LispValue
  169. lispInteger(integerValue)
  170.     int    integerValue;
  171. {
  172.     LispValue    newobj = lispAlloc();
  173.  
  174.     LISP_TYPE(newobj) =     PGLISP_INT;
  175.     newobj->equalFunc =     _equalLispValue;
  176.     newobj->outFunc =         _outLispValue;
  177.     newobj->copyFunc =         _copyLispInt;
  178.     LISPVALUE_INTEGER(newobj) = integerValue;
  179.     CDR(newobj) =         LispNil;
  180.  
  181.     return(newobj);
  182. }
  183.  
  184. /* ----------------
  185.  *    lispName returns a node of type T_LispStr
  186.  *    but gurantees that the string is char16 aligned and filled
  187.  * ----------------
  188.  */
  189. LispValue
  190. lispName(string)
  191.     char    *string;
  192. {
  193.     LispValue    newobj = lispAlloc();
  194.     char        *newstr;
  195.  
  196.     LISP_TYPE(newobj) = PGLISP_STR;
  197.     newobj->equalFunc = _equalLispValue;
  198.     newobj->outFunc = _outLispValue;
  199.     newobj->copyFunc = _copyLispStr;
  200.     CDR(newobj) = LispNil;
  201.  
  202.     if (string) {
  203.     if (strlen(string) > sizeof(NameData)) {
  204.         elog(WARN,"Name %s was longer than %d",string,sizeof(NameData));
  205.         /* NOTREACHED */
  206.     }
  207.     newstr = (char *) palloc(sizeof(NameData)+1);
  208.     newstr = strcpy(newstr,string);
  209.     } else
  210.       newstr = (char *)NULL;
  211.  
  212.     LISPVALUE_STRING(newobj) = newstr;
  213.     
  214.     return(newobj);
  215. }
  216.  
  217.  
  218. /* ----------------
  219.  *    lispString returns a node of type T_LispStr
  220.  * ----------------
  221.  */
  222. LispValue
  223. lispString(string)
  224.     char    *string;
  225. {
  226.     LispValue    newobj = lispAlloc();
  227.     char        *newstr;
  228.  
  229.     LISP_TYPE(newobj) = PGLISP_STR;
  230.     newobj->equalFunc = _equalLispValue;
  231.     newobj->outFunc =     _outLispValue;
  232.     newobj->copyFunc =     _copyLispStr;
  233.     CDR(newobj) =     LispNil;
  234.  
  235.     if (string) {
  236.     newstr = (char *) palloc(strlen(string)+1);
  237.     newstr = strcpy(newstr,string);
  238.     } else
  239.       newstr = (char *)NULL;
  240.  
  241.     LISPVALUE_STRING(newobj) = newstr;
  242.     return(newobj);
  243. }
  244.  
  245. /* ----------------
  246.  *    lispVectori returns a node of type T_LispVector
  247.  * ----------------
  248.  */
  249. LispValue
  250. lispVectori(nBytes)
  251.     int    nBytes;
  252. {
  253.     LispValue    newobj = lispAlloc();
  254.     
  255.     LISP_TYPE(newobj) = PGLISP_VECI;
  256.     newobj->equalFunc = _equalLispValue;
  257.     newobj->outFunc =     _outLispValue;
  258.     newobj->copyFunc =     _copyLispVector;
  259.     
  260.     LISPVALUE_VECI(newobj) = (struct vectori *)
  261.     palloc((unsigned) (sizeof(struct vectori) + nBytes));
  262.     LISPVALUE_VECTORSIZE(newobj) = nBytes;
  263.     CDR(newobj) = LispNil;
  264.  
  265.     return(newobj);
  266. }
  267.  
  268. LispValue
  269. evalList(list)
  270.     LispValue    list;
  271. {
  272.     elog(WARN,"trying to evaluate a list, unsupported function");
  273.     return(list);
  274. }
  275.  
  276. LispValue
  277. quote(lispObject)
  278.     LispValue    lispObject;
  279. {
  280.     elog(WARN,"calling quote which is being phased out");
  281.     return(lispObject);
  282. }
  283.  
  284. /* ===================== LISP INDEPENDENT ==================== */
  285.  
  286. /*
  287.  *    Manipulation routines.
  288.  *
  289.  *    lispList - allocate a new cons cell, initialized to (nil . nil)
  290.  *    lispCons - allocate a new cons cell, initialized to the arguments
  291.  *    nappend1 - destructive append of "object" to the end of "list"
  292.  *    car, cdr - same as LISP
  293.  *    rplaca, rplacd - same as LISP
  294.  *    init_list - set the car of a list
  295.  */
  296.  
  297. LispValue
  298. lispList()
  299. {
  300.     LispValue p;
  301.  
  302.     p = lispDottedPair();
  303.     CAR(p) = LispNil;
  304.     CDR(p) = LispNil;
  305.     return(p);
  306. }
  307.  
  308. LispValue
  309. lispCons(lispObject1, lispObject2)
  310.     LispValue lispObject1, lispObject2;
  311. {
  312.     LispValue p = lispDottedPair();
  313.  
  314.     CAR(p) = lispObject1;
  315.     CDR(p) = lispObject2;
  316.     return(p);
  317. }
  318.  
  319.  
  320. LispValue
  321. nappend1(list, lispObject)
  322.     LispValue    list, lispObject;
  323. {
  324.     LispValue    p;
  325.     
  326.     if (null(list)) {
  327.         list = lispList();
  328.         CAR(list) = lispObject;
  329.         CDR(list) = LispNil;
  330.         return(list);
  331.     }
  332.     
  333.     for (p = list; !null(CDR(p)); p = CDR(p))
  334.         ;
  335.     CDR(p) = lispList();
  336.     CAR(CDR(p)) = lispObject;
  337.     return(list);
  338. }
  339.  
  340.  
  341. /* XXX - this will only work for single level lists */
  342.  
  343. LispValue
  344. append1(list, lispObject)
  345.     LispValue    list, lispObject;
  346. {
  347.     LispValue    p = LispNil;
  348.     LispValue     retval = LispNil;
  349.  
  350.     if (null(list)) {
  351.     retval = lispList();
  352.     CAR(retval) = lispObject;
  353.     CDR(retval) = LispNil;
  354.     return(retval);
  355.     }
  356.  
  357.     for (p = list; !null(p); p = CDR(p)) {
  358.     retval = nappend1(retval,CAR(p));
  359.     }
  360.  
  361.     for (p = retval; !null(CDR(p)); p = CDR(p))
  362.       ;
  363.  
  364.     CDR(p) = lispList();
  365.     CAR(CDR(p)) = lispObject;
  366.     
  367.     return(retval);
  368. }
  369.  
  370. LispValue
  371. car(dottedPair)
  372.     LispValue    dottedPair;
  373. {
  374.     if (null(dottedPair))
  375.         return (LispNil);
  376.     
  377.     AssertArg(listp(dottedPair));
  378.     return (CAR(dottedPair));
  379. }
  380.  
  381. LispValue
  382. cdr(dottedPair)
  383.     LispValue    dottedPair;
  384. {
  385.     if (null(dottedPair))
  386.         return (LispNil);
  387.     
  388.     AssertArg(listp(dottedPair));
  389.     return (CDR(dottedPair));
  390. }
  391.  
  392. LispValue
  393. rplaca(dottedPair, newValue)
  394.     LispValue    dottedPair, newValue;
  395. {
  396.     CAR(dottedPair) = newValue;
  397.     return(dottedPair);
  398. }
  399.  
  400. LispValue
  401. rplacd(dottedPair, newValue)
  402.     LispValue    dottedPair, newValue;
  403. {
  404.     CDR(dottedPair) = newValue;
  405.     return(dottedPair);
  406. }
  407.  
  408. /* XXX fix lispList and get rid of this ... */
  409. init_list(list, newValue)
  410.     LispValue    list, newValue;
  411. {
  412.     CAR(list) = newValue;
  413.     CDR(list) = LispNil;
  414. }
  415.  
  416.  
  417. /*
  418.  *      More Manipulation routines
  419.  *
  420.  *      append   - appends lisp obj to the end of the lisp.
  421.  *                 non-destructive. XXX needs to be extended to
  422.  *                 manipulate lists
  423.  *      length   - returns the length of a list, as an int.
  424.  *      nthCdr   - returns a list where the car of the list
  425.  *                 is the indexed element.  Used to implement the
  426.  *                 nth function.
  427.  *      nconc    - returns the concatenation of *2* lists.
  428.  *                 destructive modification.
  429.  */
  430.  
  431.  
  432. LispValue
  433. append(list,lispObject)
  434.      LispValue list, lispObject;
  435. {
  436.      LispValue  p;
  437.      LispValue newlist, newlispObject;
  438.  
  439.      if (null(list))
  440.         return lispCopy(lispObject);
  441.      
  442.      Assert(listp(list));
  443.      
  444.      newlist = lispCopy(list);
  445.      newlispObject = lispCopy(lispObject);
  446.  
  447.      for (p = newlist; !null(CDR(p)); p = CDR(p))
  448.        ;
  449.      CDR(p) = newlispObject;
  450.      return(newlist);
  451.  
  452. }
  453.  
  454. /* ----------------
  455.  *    lispCopy has been moved to copyfuncs.c with the other
  456.  *    copy functions.
  457.  * ----------------
  458.  */
  459.  
  460. int
  461. length(list)
  462.      LispValue list;
  463. {
  464.      LispValue temp;
  465.      int count = 0;
  466.      for (temp = list; !null(temp); temp = CDR(temp))
  467.        count += 1;
  468.  
  469.      return(count);
  470. }
  471.  
  472.  
  473. LispValue
  474. nthCdr(index, list)
  475.      LispValue list;
  476.      int index;
  477. {
  478.     int i;
  479.     LispValue temp = list;
  480.     for (i= 1; i <= index; i++) {
  481.     if (! null(temp))
  482.         temp = CDR(temp);
  483.     else 
  484.         return(LispNil);
  485.     }
  486.     return(temp);
  487. }
  488.  
  489. LispValue
  490. nconc(list1, list2)
  491.      LispValue list1,list2;
  492. {
  493.      LispValue temp;
  494.  
  495.      if (list1 == LispNil)
  496.        return(list2);
  497.      if (list2 == LispNil)
  498.        return(list1);
  499.      if (list1 == list2)
  500.     elog(WARN,"trying to nconc a list to itself");
  501.  
  502.      for (temp = list1; !null(CDR(temp)); temp = CDR(temp))
  503.        ;
  504.  
  505.      CDR(temp) = list2;
  506.      return(list1);      /* list1 is now list1[]list2  */
  507. }
  508.  
  509.  
  510.  
  511. LispValue
  512. nreverse(list)
  513.      LispValue list;
  514. {
  515.      LispValue temp =LispNil;
  516.      LispValue rlist = LispNil;
  517.      LispValue p = LispNil;
  518.      bool last = true;
  519.  
  520.      if(null(list))
  521.        return(LispNil);
  522.  
  523.      Assert(IsA(list,LispList));
  524.  
  525.      if (length(list) == 1)
  526.        return(list);
  527.  
  528.      for (p = list; !null(p); p = CDR(p)) {
  529.             rlist = lispCons(CAR(p),rlist);
  530.      }
  531.  
  532.      CAR(list) = CAR(rlist);
  533.      CDR(list) = CDR(rlist);
  534.      return(list);
  535. }
  536.  
  537. int
  538. position(foo,bar)
  539.      LispValue foo;
  540.      List bar;
  541. {
  542.     return(0);
  543. }
  544.  
  545. /*
  546.  * member()
  547.  * - nondestructive, returns t iff foo is a member of the list
  548.  *   bar
  549.  */
  550. bool
  551. member(foo,bar)
  552.      LispValue foo;
  553.      List bar;
  554. {
  555.     LispValue i;
  556.     foreach (i,bar)
  557.       if (equal((Node)(CAR(i)),(Node)foo))
  558.     return(true);
  559.     return(false);
  560. }
  561.  
  562. LispValue
  563. remove_duplicates(foo,test)
  564.      List foo;
  565.      bool (* test)();
  566. {
  567.     LispValue i;
  568.     LispValue j;
  569.     LispValue result = LispNil;
  570.     bool there_exists_duplicate = false;
  571.     int times = 0;
  572.  
  573.     if (length(foo) == 1)
  574.     return(foo);
  575.     
  576.     foreach (i,foo) {
  577.     if (listp(i) && !null(i)) {
  578.         foreach (j,CDR(i)) {
  579.         if ( (* test)(CAR(i),CAR(j)) )
  580.           there_exists_duplicate = true;
  581.         }
  582.         if (! there_exists_duplicate) 
  583.           result = nappend1(result, CAR(i) );
  584.  
  585.         there_exists_duplicate = false;
  586.     }
  587.     }
  588.     /* XXX assumes that the last element in the list is never
  589.      *  deleted.
  590.      */
  591. /*    result = nappend1(result,last_element(foo));  */
  592.     return(result);
  593. }
  594.  
  595. /* Returns the leftmost element in the list which 
  596.  * does not satisfy the predicate.  Returns LispNil 
  597.  * if no elements satisfiy the pred.
  598.  */
  599.  
  600. LispValue
  601. find_if_not(pred,bar)
  602.      LispValue bar;
  603.      bool (*pred)();
  604. {
  605.     LispValue temp;
  606.     
  607.     foreach(temp,bar)
  608.       if (!(*pred)(CAR(temp)))
  609.     return(CAR(temp));
  610.     return(LispNil);
  611. }
  612.  
  613. LispValue
  614. LispDelete(foo,bar)
  615.      LispValue foo;
  616.      List bar;
  617. {
  618.     LispValue i = LispNil;
  619.     LispValue j = LispNil;
  620.  
  621.     foreach (i,bar) {
  622.     if (equal((Node)(CAR(i)),(Node)(foo)))
  623.       if (i == bar ) {
  624.           /* first element */
  625.           CAR(bar) = CAR(CDR(bar));
  626.           CDR(bar) = CDR(CDR(bar));
  627.       } else {
  628.           CDR(j) = CDR(i);
  629.       }
  630.     j = i;
  631.     }
  632. }
  633.  
  634. LispValue
  635. setf(foo,bar)
  636.      LispValue foo,bar;
  637. {
  638.     elog(WARN,"unsupported function, 'setf' being called");
  639.     return(bar);
  640. }
  641.  
  642. LispValue
  643. LispRemove(foo,bar)
  644.      LispValue foo;
  645.      List bar;
  646. {
  647.     LispValue temp = LispNil;
  648.     LispValue result = LispNil;
  649.  
  650.     for (temp = bar; !null(temp); temp = CDR(temp))
  651.       if (! equal((Node)(foo),(Node)(CAR(temp))) ) {
  652.       result = append1(result,CAR(temp));
  653.       }
  654.       
  655.     return(result);
  656. }
  657.  
  658. List
  659. nLispRemove(foo, bar)
  660. List foo;
  661. LispValue bar;
  662. {
  663.     LispValue x;
  664.     List result = LispNil;
  665.  
  666.     foreach (x, foo)
  667.     if (bar != CAR(x))
  668.         result = nappend1(result, CAR(x));
  669.     return result;
  670. }
  671.  
  672.  
  673. LispValue
  674. set_difference(foo,bar)
  675.      LispValue foo,bar;
  676. {
  677.     LispValue temp1 = LispNil;
  678.     LispValue result = LispNil;
  679.  
  680.     if(null(bar))
  681.     return(foo); 
  682.     
  683.     foreach (temp1,foo) {
  684.     if (! member(CAR(temp1),bar))
  685.       result = nappend1(result,CAR(temp1));
  686.     }
  687.     return(result);
  688. }
  689.  
  690. List
  691. nset_difference(foo, bar)
  692. List foo, bar;
  693. {
  694.     LispValue x;
  695.     List result;
  696.  
  697.     result = foo;
  698.     foreach (x, bar) {
  699.     result = nLispRemove(result, CAR(x));
  700.       }
  701.     return result;
  702. }
  703.  
  704. LispValue
  705. push(foo,bar)
  706.      LispValue foo;
  707.      List bar;
  708. {
  709.     LispValue tmp = lispList();
  710.  
  711.     if (null(bar)) {
  712.         CAR(tmp) = foo;
  713.         CDR(tmp) = LispNil;
  714.         return(tmp);
  715.     }
  716.  
  717.     CAR(tmp) = CAR(bar);
  718.     CDR(tmp) = CDR(bar);
  719.  
  720.     CAR(bar) = foo;
  721.     CDR(bar) = tmp;
  722.  
  723.     return(bar);
  724. }
  725.  
  726. LispValue 
  727. last(foo)
  728.      LispValue foo;
  729. {
  730.     LispValue bar;
  731.     for (bar = foo; !null(CDR(bar)); bar = CDR(bar))
  732.       ;
  733.     return(bar);
  734. }
  735.  
  736. LispValue
  737. LispUnion(foo,bar)
  738.      LispValue foo,bar;
  739. {
  740.     LispValue retval = LispNil;
  741.     LispValue i = LispNil;
  742.     LispValue j = LispNil;
  743.     
  744.     if (null(foo))
  745.       return(bar); /* XXX - should be copy of bar */
  746.     
  747.     if (null(bar))
  748.       return(foo); /* XXX - should be copy of foo */
  749.     
  750.     Assert(IsA(foo,LispList));
  751.     Assert(IsA(bar,LispList));
  752.  
  753.     foreach (i,foo) {
  754.     foreach (j,bar) {
  755.         if (! equal((Node)(CAR(i)),(Node)(CAR(j)))) {
  756.           retval = nappend1(retval,CAR(i));
  757.           break;
  758.         }
  759.     }
  760.     }
  761.     foreach(i,bar) {
  762.       retval = nappend1(retval,CAR(i));
  763.     }
  764.  
  765.     return(retval);
  766. }
  767.  
  768. /* temporary functions */
  769.  
  770. LispValue 
  771. mapcar(foo,bar)
  772.      void (*foo)();
  773.      LispValue bar;
  774. {
  775.     elog(WARN, "unsupported function 'mapcar'");
  776.     return(bar);
  777. }
  778.  
  779. bool
  780. zerop(foo)
  781.      LispValue foo;
  782. {
  783.     if (integerp(foo))
  784.     return((bool)(CInteger(foo) == 0));
  785.     else {
  786.     elog(WARN,"zerop called on noninteger");
  787.     return ((bool) 1); /* non-integer is always zero */
  788.     }
  789. }
  790.  
  791. LispValue
  792. lispArray(foo)
  793.      int foo;
  794. {
  795.     elog(WARN,"bogus function : lispArray");
  796.     return(lispInteger(foo));
  797. }
  798.  
  799. /*    
  800.  *        number-list
  801.  *    
  802.  *        Returns a list with 'n' fixnums from 'start' in order.
  803.  *    
  804.  */
  805.  
  806. List
  807. number_list(start,n)
  808.      int start,n;
  809. {
  810.     LispValue return_list = LispNil;
  811.     int i,j;
  812.  
  813.     for(i = start, j = 0; j < n ; j++,i++ )
  814.       return_list = nappend1(return_list,lispInteger(i));
  815.  
  816.     return(return_list);
  817. }
  818.  
  819.  
  820. LispValue
  821. apply(foo,bar)
  822.      LispValue (*foo)();
  823.      LispValue bar;
  824. {
  825.     elog(WARN,"unsupported function 'apply' being called");
  826.     return(bar);
  827. }
  828.  
  829. LispValue
  830. find_if(pred,bar)
  831.      bool (*pred )();
  832.      LispValue bar;
  833. {
  834.     LispValue temp;
  835.  
  836.     foreach (temp,bar) 
  837.       if ((*pred)(CAR(temp)))
  838.     return(CAR(temp));
  839.     return(LispNil);
  840. }
  841.  
  842. LispValue
  843. find(foo,bar,test, key)
  844.      LispValue foo;
  845.      LispValue bar;
  846.      bool (*test)();
  847.      Node (*key)();
  848.  
  849. {
  850.     LispValue temp;
  851.  
  852.     elog(WARN,"unsupported function");
  853.  
  854.     foreach(temp,bar) {
  855.     if ((*test)(foo,(*key)(CAR(temp))))
  856.       return(CAR(temp));
  857.     }
  858.     return(LispNil);
  859. }
  860.  
  861. LispValue
  862. some(foo,bar)
  863.      bool(*foo)();
  864.      LispValue bar;
  865. {
  866.     LispValue i = LispNil;
  867.     LispValue temp = LispNil;
  868.  
  869.     foreach(i,bar) {
  870.     temp =CAR(i);
  871.     if ((*foo)(temp))
  872.       return(temp);
  873.     }
  874.     return(LispNil);
  875.     
  876. }
  877.  
  878. LispValue
  879. sort(foo)
  880.      LispValue foo;
  881. {
  882.     if (length(foo) == 1)
  883.       return(foo);
  884.     else {
  885.      elog(WARN,"unsupported function");
  886.      return(foo);
  887.     }
  888. }
  889.  
  890. double
  891. expt(foo)
  892.      double foo;
  893. {
  894.     elog(WARN,"unsupported function");
  895.     return foo;
  896. }
  897.  
  898. bool
  899. same(foo,bar)
  900.      LispValue foo;
  901.      LispValue bar;
  902. {
  903.   LispValue temp = LispNil;
  904.  
  905.   if (null(foo))
  906.     return(null(bar));
  907.   if (null(bar))
  908.     return(null(foo));
  909.   if (length(foo) == length(bar)) {
  910.     foreach (temp,foo) {
  911.       if (!member(CAR(temp),bar))
  912.     return(false);
  913.     }
  914.     return(true);
  915.   }
  916.   return(false);
  917.     
  918. }      
  919.  
  920. /*---------------------------------------------------------------------
  921.  *    lispDisplayFp
  922.  *
  923.  *    Print a PGLISP tree depth-first.
  924.  *---------------------------------------------------------------------
  925.  */
  926.  
  927. void 
  928. lispDisplayFp(fp, lispObject)
  929. FILE         *fp;
  930. LispValue    lispObject;
  931. {
  932.     char *s;
  933.  
  934.     s = lispOut(lispObject);
  935.     fprintf(fp, "%s", s);
  936.     pfree(s);
  937. }
  938.  
  939. /*------------------------------------------------------------------
  940.  *    lispDisplay
  941.  *
  942.  *     Print a PGLISP tree depth-first in stdout
  943.  *------------------------------------------------------------------
  944.  */
  945. void
  946. lispDisplay(lispObject)
  947. LispValue    lispObject;
  948. {
  949.     lispDisplayFp(stdout, lispObject);
  950.     fflush(stdout);
  951. }
  952.  
  953. /*--------------------------------------------------------------------------
  954.  * lispOut
  955.  *
  956.  * Given a lisp structure, create a string with its visula representation.
  957.  *
  958.  * Keep Postgres memory clean! Don't forget to 'pfree' the string when
  959.  * you are done with it!
  960.  *--------------------------------------------------------------------------
  961.  */
  962. char *
  963. lispOut(lispObject)
  964.     LispValue    lispObject;
  965. {
  966.     StringInfo str;
  967.     char *s;
  968.  
  969.     str = makeStringInfo();
  970.     _outLispValue(str, lispObject);
  971.     s = str->data;
  972.  
  973.     /*
  974.      * free the StringInfoData, but not the string itself...
  975.      */
  976.     pfree((Pointer)str);
  977.  
  978.     return(s);
  979. }
  980.  
  981. /*--------------------------------------------------------------------------
  982.  * _outLispValue
  983.  *
  984.  * Given a lisp structure, create a string with its visual representation.
  985.  * In fact, we do not create a string, but a 'StringInfo'.
  986.  * If you want to get back just the string, use 'lispOut'.
  987.  *
  988.  *--------------------------------------------------------------------------
  989.  */
  990.  
  991. void
  992. _outLispValue(str, lispObject)
  993. StringInfo str;
  994. LispValue    lispObject;
  995. {
  996.  
  997.     register int i;
  998.     register LispValue t;
  999.     register int done;
  1000.     char buf[500];
  1001.     char *buf2;
  1002.  
  1003.  
  1004.     if (null(lispObject)) {
  1005.     appendStringInfo(str, "nil ");
  1006.     return;
  1007.     }
  1008.  
  1009.     switch(lispObject->type) {
  1010.     case PGLISP_ATOM:
  1011.         buf2 = AtomValueGetString((int)(LISPVALUE_SYMBOL(lispObject)));
  1012.         sprintf(buf, "%s ", buf2);
  1013.         appendStringInfo(str, buf);
  1014.         break;
  1015.     case PGLISP_DTPR:
  1016.         appendStringInfo(str, "(");
  1017.         /*
  1018.          * This object can be the beginning of a list of objects,
  1019.          * or a single dotted pair (e.g. "(1 . 2)").
  1020.          * In the first case its CDR will be either NIL or
  1021.          * another dotted pair.
  1022.          * In the second case it won't!
  1023.          */
  1024.         done = 0;
  1025.         t = lispObject;
  1026.         while (!done) {
  1027.         /*
  1028.          * first, print the CAR
  1029.          */
  1030.         _outLispValue(str, CAR(t));
  1031.         /*
  1032.          * Now check the CDR & decide what to do...
  1033.          */
  1034.         if (null(CDR(t))) {
  1035.             /*
  1036.              * End of list
  1037.              */
  1038.             done = 1;
  1039.         } else if (consp(CDR(t))) {
  1040.             /*
  1041.              * there is at least another element in the list
  1042.              */
  1043.             t = CDR(t);
  1044.         } else {
  1045.             /*
  1046.              * this is a dotted pair
  1047.              * print its CDR too and get out of here!
  1048.              */
  1049.             appendStringInfo(str, " . ");
  1050.             _outLispValue(str, CDR(t));
  1051.             done = 1;
  1052.         }
  1053.         } /*while*/
  1054.         appendStringInfo(str, ")");
  1055.         break;
  1056.     case PGLISP_FLOAT:
  1057.         sprintf(buf, "%g ", LISPVALUE_DOUBLE(lispObject));
  1058.         appendStringInfo(str, buf);
  1059.         break;
  1060.     case PGLISP_INT:
  1061.         sprintf(buf, "%d ", LISPVALUE_INTEGER(lispObject));
  1062.         appendStringInfo(str, buf);
  1063.         break;
  1064.     case PGLISP_STR:
  1065.         sprintf(buf, "\"%s\" ", LISPVALUE_STRING(lispObject));
  1066.         appendStringInfo(str, buf);
  1067.         break;
  1068.     case PGLISP_VECI:
  1069.         sprintf(buf, "#<%d:", LISPVALUE_VECTORSIZE(lispObject));
  1070.         appendStringInfo(str, buf);
  1071.         for (i = 0; i < LISPVALUE_VECTORSIZE(lispObject); ++i) {
  1072.         sprintf(buf, " %d", LISPVALUE_BYTEVECTOR(lispObject)[i]);
  1073.         appendStringInfo(str, buf);
  1074.         }
  1075.         sprintf(buf, " >");
  1076.         appendStringInfo(str, buf);
  1077.         break;
  1078.     default:
  1079.         (* ((Node)lispObject)->outFunc)(str, lispObject);
  1080.         break;
  1081.     }
  1082.  
  1083. }
  1084.